home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / drdobbs / 1989 / 05 / kermit.asc < prev    next >
Text File  |  1989-05-12  |  45KB  |  1,525 lines
  1. _Kermit Meets Modula-2_
  2. by Brian Anderson
  3.  
  4.  
  5. [LISTING ONE]
  6.  
  7. MODULE PCKermit;
  8.  
  9.    FROM Break IMPORT
  10.       DisableBreak, EnableBreak;
  11.  
  12.    FROM Terminal IMPORT
  13.       WriteString, WriteLn, Read;
  14.  
  15.    FROM Shell IMPORT
  16.       dispOpts, Options, Dir, Connect, eXit, MainHelp;
  17.       
  18.    FROM PAD IMPORT
  19.       Send, Receive;
  20.             
  21.       
  22.    VAR 
  23.       Quit : BOOLEAN;
  24.       ch : CHAR;
  25.  
  26.             
  27. BEGIN   (* main program *)
  28.    DisableBreak;   (* don't recognize Control-C *)
  29.    WriteLn;   WriteLn;
  30.    WriteString ("Welcome to PCKermit -- Mainframe to Micro Communications");
  31.    WriteLn;
  32.    dispOpts; 
  33.    Quit := FALSE;
  34.    REPEAT
  35.       WriteLn;   WriteLn;
  36.       WriteString ("PCKermit [O, C, D, S, R, X, ?]: ");   
  37.       LOOP
  38.          Read (ch);     
  39.          CASE CAP (ch) OF
  40.             'O' : Options;       EXIT;
  41.          |  'C' : Connect;       EXIT;
  42.          |  'D' : Dir;           EXIT;
  43.          |  'S' : Send;          EXIT;
  44.          |  'R' : Receive;       EXIT;
  45.          |  'X' : eXit (Quit);   EXIT;
  46.          |  '?' : MainHelp;      EXIT;
  47.          ELSE
  48.             (* ignore *)
  49.          END;
  50.       END;
  51.    UNTIL Quit;
  52.    EnableBreak;
  53. END PCKermit.
  54.  
  55. [LISTING TWO]
  56.  
  57. DEFINITION MODULE Shell;   (* User interface for Kermit *)
  58.  
  59.    EXPORT QUALIFIED
  60.       dispOpts, Options, Dir, Connect, eXit, MainHelp;
  61.       
  62.    PROCEDURE dispOpts;
  63.    (* Display communications parameters for the user *)
  64.  
  65.    PROCEDURE Options;
  66.    (* set communications options *)
  67.    
  68.    PROCEDURE Dir;
  69.    (* Displays a directory *)
  70.    
  71.    PROCEDURE Connect;
  72.    (* Terminal mode allows connection to host (possibly through MODEM) *)
  73.  
  74.    PROCEDURE eXit (VAR q : BOOLEAN);
  75.    (* Allow user to exit program after prompting for confirmation *)
  76.    
  77.    PROCEDURE MainHelp;
  78.    (* help menu for  main program loop *)
  79.  
  80. END Shell.
  81.  
  82.  
  83.  
  84. [LISTING THREE]
  85.  
  86.  
  87. DEFINITION MODULE PAD;   (* Packet Assembler/Disassembler for Kermit *)
  88.  
  89.    EXPORT QUALIFIED
  90.       PacketType, yourNPAD, yourPADC, yourEOL, Send, Receive;
  91.       
  92.    TYPE
  93.       (* PacketType used in both PAD and DataLink modules *)
  94.       PacketType = ARRAY [1..100] OF CHAR;
  95.       
  96.    VAR
  97.       (* yourNPAD, yourPADC, and yourEOL used in both PAD and DataLink *)
  98.       yourNPAD : CARDINAL;   (* number of padding characters *)
  99.       yourPADC : CHAR;       (* padding characters *)
  100.       yourEOL  : CHAR;       (* End Of Line -- terminator *)
  101.             
  102.    PROCEDURE Send;
  103.    (* Sends a file after prompting for filename *)
  104.    
  105.    PROCEDURE Receive;
  106.    (* Receives a file (or files) *)
  107.  
  108. END PAD.
  109.  
  110.  
  111. [LISTING FOUR]
  112.  
  113.  
  114. DEFINITION MODULE Files;   (* File I/O for Kermit *)
  115.  
  116.    FROM FileSystem IMPORT
  117.       File;
  118.       
  119.    EXPORT QUALIFIED
  120.       Status, FileType, Open, Create, CloseFile, Get, Put, DoWrite;
  121.          
  122.    TYPE
  123.       Status = (Done, Error, EOF);
  124.       FileType = (Input, Output);
  125.    
  126.    PROCEDURE Open (VAR f : File; name : ARRAY OF CHAR) : Status;
  127.    (* opens an existing file for reading, returns status *)
  128.    
  129.    PROCEDURE Create (VAR f : File; name : ARRAY OF CHAR) : Status;
  130.    (* creates a new file for writing, returns status *)
  131.    
  132.    PROCEDURE CloseFile (VAR f : File; Which : FileType) : Status;
  133.    (* closes a file after reading or writing *)
  134.    
  135.    PROCEDURE Get (VAR f : File; VAR ch : CHAR) : Status;
  136.    (* Reads one character from the file, returns status *)
  137.    
  138.    PROCEDURE Put (ch : CHAR);
  139.    (* Writes one character to the file buffer *)
  140.    
  141.    PROCEDURE DoWrite (VAR f : File) : Status;
  142.    (* Writes buffer to disk only if nearly full *)
  143.    
  144. END Files.
  145.  
  146.  
  147.  
  148. [LISTING FIVE]
  149.  
  150. DEFINITION MODULE DataLink;   (* Sends and Receives Packets for PCKermit *)
  151.  
  152.    FROM PAD IMPORT
  153.       PacketType;
  154.       
  155.    EXPORT QUALIFIED
  156.       FlushUART, SendPacket, ReceivePacket;
  157.       
  158.    PROCEDURE FlushUART;
  159.    (* ensure no characters left in UART holding registers *)
  160.     
  161.    PROCEDURE SendPacket (s : PacketType);
  162.    (* Adds SOH and CheckSum to packet *)
  163.    
  164.    PROCEDURE ReceivePacket (VAR r : PacketType) : BOOLEAN;
  165.    (* strips SOH and checksum -- return FALSE if timed out or bad checksum *)
  166.    
  167. END DataLink.
  168.  
  169.  
  170.  
  171. [LISTING SIX]
  172.  
  173.  
  174. IMPLEMENTATION MODULE Shell;   (* User interface for Kermit *)
  175.  
  176.    FROM SYSTEM IMPORT
  177.       AX, BX, CX, DX, SETREG, SWI;
  178.  
  179.    FROM Exec IMPORT
  180.       DosCommand;
  181.             
  182.    FROM Terminal IMPORT
  183.       WriteString, WriteLn, KeyPressed, ReadString;
  184.       
  185.    IMPORT Terminal;   (* for Terminal.Write and Terminal.Read *)
  186.  
  187.    FROM InOut IMPORT
  188.       WriteCard;
  189.       
  190.    FROM RS232Int IMPORT
  191.       Init, StartReading, StopReading;
  192.    
  193.    IMPORT RS232Int;   (* for RS232Int.Write and RS232Int.BusyRead *)
  194.  
  195.    FROM Strings IMPORT
  196.       Length, Concat;
  197.    
  198.    FROM NumberConversion IMPORT
  199.       StringToCard;
  200.             
  201.    IMPORT ASCII;
  202.    
  203.       
  204.    VAR
  205.       baudRate : CARDINAL;
  206.       stopBits : CARDINAL;
  207.       parityBit : BOOLEAN;
  208.       evenParity : BOOLEAN;
  209.       nbrOfBits : CARDINAL;
  210.       OK : BOOLEAN;
  211.       echo : (Off, Local, On);      
  212.       ch : CHAR;
  213.       str : ARRAY [0..10] OF CHAR;
  214.       n : CARDINAL;
  215.             
  216.  
  217.    PROCEDURE Initialize;
  218.       BEGIN
  219.          Init (baudRate, stopBits, parityBit, evenParity, nbrOfBits, OK);
  220.       END Initialize;
  221.       
  222.    
  223.    PROCEDURE ClrScr;
  224.    (* Clear the screen, and home the cursor *)
  225.       BEGIN
  226.          SETREG (AX, 0600H);   (* function 6 = scroll or clear window *)   
  227.          SETREG (BX, 0700H);   (* 7 = normal screen attribute *)
  228.          SETREG (CX, 0000H);   (* top LH of screen *)
  229.          SETREG (DX, 184FH);   (* bottom RH of screen *)
  230.          SWI (10H);   (* call bios *)
  231.          SETREG (AX, 0200h);   (* function 2 = position cursor *)
  232.          SETREG (BX, 0000H);   (* page 0 *)
  233.          SETREG (DX, 0000H);   (* home position *)
  234.          SWI (10H);   (* call bios *)
  235.       END ClrScr;
  236.       
  237.       
  238.    PROCEDURE CommHelp;
  239.    (* help menu for communications options *)
  240.       BEGIN
  241.          ClrScr;
  242.          WriteString ("  C o m m u n i c a t i o n s   O p t i o n s");
  243.          WriteLn;
  244.          WriteString ("              H e l p   M e n u");
  245.          WriteLn;   WriteLn;
  246.          WriteString ("set Baud rate ................................ B");
  247.          WriteLn;
  248.          WriteString ("set Parity ................................... P");
  249.          WriteLn;
  250.          WriteString ("set Word length .............................. W");
  251.          WriteLn;
  252.          WriteString ("set Stop bits ................................ S");
  253.          WriteLn;
  254.          WriteString ("eXit ......................................... X");
  255.          WriteLn;
  256.       END CommHelp;
  257.       
  258.             
  259.    PROCEDURE dispOpts;
  260.    (* Display communications parameters for the user *)
  261.       BEGIN
  262.          WriteLn;
  263.          WriteString ("Baud rate = ");   WriteCard (baudRate, 0);
  264.          WriteString (";  ");
  265.          IF parityBit THEN
  266.             IF evenParity THEN
  267.                WriteString ("Even ");
  268.             ELSE
  269.                WriteString ("Odd ");
  270.             END;
  271.          ELSE
  272.             WriteString ("No ");
  273.          END;
  274.          WriteString ("parity;  ");
  275.          WriteCard (nbrOfBits, 0);
  276.          WriteString (" Data bits;  ");   
  277.          IF stopBits = 1 THEN
  278.             WriteString ("One stop bit.");
  279.          ELSE
  280.             WriteString ("Two stop bits.");
  281.          END;
  282.          WriteLn;
  283.       END dispOpts;
  284.       
  285.       
  286.    PROCEDURE Options;
  287.    (* set communications options *)
  288.    
  289.       VAR
  290.          Quit : BOOLEAN;
  291.          
  292.       BEGIN
  293.          ClrScr;
  294.          Quit := FALSE;
  295.          dispOpts;
  296.          
  297.          REPEAT
  298.             WriteLn;   WriteLn;
  299.             WriteString ("Set Communications Options [B, P, W, S, X, ?]: ");   
  300.             LOOP
  301.                Terminal.Read (ch);   
  302.                CASE CAP (ch) OF
  303.                   'B' : Baud;           EXIT;
  304.                |  'P' : Parity;         EXIT;   
  305.                |  'W' : Word;           EXIT;
  306.                |  'S' : Stops;          EXIT;
  307.                |  '?' : CommHelp;       EXIT;
  308.                |  'X' : Quit := TRUE;   EXIT;
  309.                ELSE
  310.                   (* ignore *)
  311.                END;
  312.             END;
  313.             IF Quit THEN
  314.                ClrScr;
  315.             ELSE
  316.                Initialize;
  317.                dispOpts;
  318.             END;
  319.          UNTIL Quit;
  320.       END Options;
  321.       
  322.       
  323.    PROCEDURE Baud;
  324.    (* Allow user to change the bit rate of the communications port *)
  325.       BEGIN
  326.          WriteString ("Baud Rate? [110 - 9600]: ");
  327.          ReadString (str);
  328.          IF Length (str) # 0 THEN
  329.             StringToCard (str, n, OK); 
  330.             IF OK THEN
  331.                CASE n OF
  332.                    110, 150, 300, 600, 1200, 2400, 4800, 9600 : baudRate := n;
  333.                ELSE
  334.                   (* do nothing *)
  335.                END;
  336.             END;
  337.          END;
  338.       END Baud;
  339.  
  340.    
  341.    PROCEDURE Word;
  342.    (* Allow user to change the word length of the communications port *)
  343.       BEGIN
  344.          WriteString ("Word Length? [7, 8]: ");
  345.          ReadString (str);
  346.          IF Length (str) # 0 THEN
  347.             StringToCard (str, n, OK);
  348.             IF OK AND (n IN {7, 8}) THEN
  349.                nbrOfBits := n;
  350.             END;
  351.          END;
  352.       END Word;
  353.       
  354.    
  355.    PROCEDURE Parity;
  356.    (* Allow user to change the parity bit of the communications port *)
  357.       BEGIN
  358.          WriteString ("Parity? [None, Even, Odd]: ");
  359.          ReadString (str);
  360.          IF Length (str) # 0 THEN
  361.             CASE CAP (str[0]) OF
  362.                'N' : parityBit := FALSE; 
  363.             |  'E' : parityBit := TRUE;   evenParity := TRUE;
  364.             |  'O' : parityBit := TRUE;   evenParity := FALSE;
  365.             ELSE
  366.                (* no action *)
  367.             END;
  368.          END;
  369.       END Parity;
  370.  
  371.       
  372.    PROCEDURE Stops;
  373.    (* Allow user to change the number of stop bits *)
  374.       BEGIN
  375.          WriteString ("Stop Bits? [1, 2]: ");
  376.          ReadString (str);
  377.          IF Length (str) # 0 THEN
  378.             StringToCard (str, n, OK);
  379.             IF OK AND (n IN {1, 2}) THEN
  380.                stopBits := n;
  381.             END;
  382.          END;
  383.       END Stops;
  384.             
  385.       
  386.    PROCEDURE Dir;
  387.    
  388.       VAR
  389.          done, gotFN : BOOLEAN;
  390.          path : ARRAY [0..60] OF CHAR;         
  391.          filename : ARRAY [0..20] OF CHAR;
  392.          i, j, k : INTEGER;
  393.          
  394.       BEGIN
  395.          filename := "";   (* in case no directory change *)
  396.          WriteString ("Path? (*.*): ");
  397.          ReadString (path);
  398.          i := Length (path);
  399.          IF i # 0 THEN
  400.             gotFN := FALSE;
  401.             WHILE (i >= 0) AND (path[i] # '\') DO
  402.                IF path[i] = '.' THEN
  403.                   gotFN := TRUE;
  404.                END;
  405.                DEC (i);
  406.             END;
  407.             IF gotFN THEN
  408.                j := i + 1;
  409.                k := 0;
  410.                WHILE path[j] # 0C DO
  411.                   filename[k] := path[j];
  412.                   INC (k);       INC (j);
  413.                END;
  414.                filename[k] := 0C;
  415.                IF (i = -1) OR (i = 0) AND (path[0] = '\')) THEN
  416.                   INC (i);
  417.                END;
  418.                path[i] := 0C;
  419.             END;
  420.          END;
  421.          IF Length (path) # 0 THEN
  422.             DosCommand ("CHDIR", path, done);
  423.          END;
  424.          IF Length (filename) = 0 THEN
  425.             filename := "*.*";
  426.          END;
  427.          Concat (filename, "/w", filename);
  428.          ClrScr;
  429.          DosCommand ("DIR", filename, done);   
  430.       END Dir;
  431.    
  432.    
  433.    PROCEDURE ConnectHelp;
  434.    (* provide help while in connect mode *)
  435.       BEGIN
  436.          ClrScr;
  437.          WriteString ("LOCAL COMMANDS:");   WriteLn;
  438.          WriteString ("^E = Echo mode");   WriteLn;
  439.          WriteString ("^L = Local echo mode");   WriteLn;
  440.          WriteString ("^T = Terminal mode (no echo)");   WriteLn;
  441.          WriteString ("^X = eXit from connect");   WriteLn;   
  442.          WriteLn;  WriteLn;
  443.       END ConnectHelp;
  444.       
  445.       
  446.    PROCEDURE Connect;
  447.    (* Terminal mode allows connection to host (possibly through MODEM) *)
  448.    
  449.       VAR
  450.          Input : BOOLEAN;
  451.          
  452.       BEGIN
  453.          ConnectHelp;
  454.          REPEAT
  455.             RS232Int.BusyRead (ch, Input);
  456.             IF Input THEN
  457.                IF ((ch >= 40C) AND (ch < 177C)) 
  458.                 OR (ch = ASCII.cr) OR (ch = ASCII.lf) OR (ch = ASCII.bs) THEN
  459.                   Terminal.Write (ch);
  460.                END;
  461.                IF echo = On THEN
  462.                   RS232Int.Write (ch);
  463.                END;
  464.             END;
  465.             
  466.             IF KeyPressed() THEN
  467.                Terminal.Read (ch);
  468.                IF ch = ASCII.enq THEN   (* Control-E *)
  469.                   echo := On;
  470.                ELSIF ch = ASCII.ff THEN   (* Control-L *)
  471.                   echo := Local;
  472.                ELSIF ch = ASCII.dc4 THEN   (* Control-T *)
  473.                   echo := Off;
  474.                ELSIF ((ch >= 40C) AND (ch < 177C)) 
  475.                 OR (ch = ASCII.EOL) OR (ch = ASCII.bs) THEN
  476.                   IF ch = ASCII.EOL THEN
  477.                      RS232Int.Write (ASCII.cr);
  478.                      RS232Int.Write (ASCII.lf);
  479.                   ELSE
  480.                      RS232Int.Write (ch);
  481.                   END;
  482.                   IF (echo = On) OR (echo = Local) THEN
  483.                      Terminal.Write (ch);
  484.                   END;
  485.                END;
  486.             END;
  487.          UNTIL ch = ASCII.can;   (* Control-X *)
  488.       END Connect;
  489.       
  490.  
  491.    PROCEDURE eXit (VAR q : BOOLEAN);
  492.    (* Allow user to exit program after prompting for confirmation *)
  493.       BEGIN
  494.          WriteString ("Exit PCKermit? [Y/N]: ");
  495.          Terminal.Read (ch);
  496.          IF CAP (ch) = 'Y' THEN
  497.             Terminal.Write ('Y');   
  498.             StopReading;   (* turn off the serial port *)
  499.             q := TRUE;
  500.          ELSE
  501.             Terminal.Write ('N');
  502.          END;
  503.          WriteLn;
  504.       END eXit;
  505.    
  506.  
  507.    PROCEDURE MainHelp;
  508.    (* help menu for  main program loop *)
  509.       BEGIN
  510.          ClrScr;
  511.          WriteString ("  P C K e r m i t   H e l p   M e n u");    WriteLn;
  512.          WriteLn;
  513.          WriteString ("set communications Options ............. O");
  514.          WriteLn;
  515.          WriteString ("Connect to host ........................ C");   
  516.          WriteLn;
  517.          WriteString ("Directory .............................. D");
  518.          WriteLn;
  519.          WriteString ("Send a file ............................ S");   
  520.          WriteLn;
  521.          WriteString ("Receive a file ......................... R");   
  522.          WriteLn;
  523.          WriteString ("eXit ................................... X");   
  524.          WriteLn;   WriteLn;
  525.          WriteString ("To establish connection to Host:");   WriteLn;
  526.          WriteString ("  -Use Connect Mode");   WriteLn;
  527.          WriteString ("  -Dial Host (AT command set?)");   WriteLn;
  528.          WriteString ("  -Log On to Host");   WriteLn;
  529.          WriteString ("  -Issue Send (or Receive) command");   WriteLn;
  530.          WriteString ("  -Return to main menu (^X)");   WriteLn;
  531.          WriteString ("  -Issue Receive (or Send) command");   WriteLn;   
  532.          WriteLn;
  533.       END MainHelp;
  534.  
  535.  
  536. BEGIN   (* module initialization *)
  537.    ClrScr;
  538.    baudRate := 1200;
  539.    stopBits := 1;
  540.    parityBit := TRUE;
  541.    evenParity := TRUE;
  542.    nbrOfBits := 7;
  543.    Initialize;
  544.    StartReading;   (* turn on the serial port *)
  545.    echo := Off;
  546. END Shell.
  547.  
  548.  
  549.  
  550. [LISTING SEVEN]
  551.  
  552. IMPLEMENTATION MODULE PAD;   (* Packet Assembler/Disassembler for Kermit *)
  553.  
  554.    FROM InOut IMPORT
  555.       Write, WriteString, WriteInt, WriteHex, WriteLn;
  556.       
  557.    FROM Terminal IMPORT
  558.       ReadString, Read, KeyPressed;
  559.  
  560.    FROM Strings IMPORT
  561.       Length;
  562.       
  563.    FROM BitByteOps IMPORT
  564.       ByteXor;
  565.  
  566.    FROM FileSystem IMPORT
  567.       File;
  568.       
  569.    FROM Files IMPORT
  570.       Status, FileType, Open, Create, CloseFile, Get, Put, DoWrite;
  571.  
  572.    FROM DataLink IMPORT
  573.       FlushUART, SendPacket, ReceivePacket;
  574.                   
  575.    IMPORT ASCII;
  576.    
  577.  
  578.    CONST
  579.       myMAXL = 94;
  580.       myTIME = 10;
  581.       myNPAD = 0;
  582.       myPADC = 0C;
  583.       myEOL  = 0C;
  584.       myQCTL = '#';
  585.       myQBIN = '&';
  586.       myCHKT = '1';     (* one character checksum *)
  587.       MAXtrys = 5;
  588.       
  589.    TYPE
  590.       (* From Definition Module:
  591.       PacketType = ARRAY [1..100] OF CHAR;
  592.       *)
  593.       PathnameType = ARRAY [0..40] OF CHAR;
  594.                   
  595.    VAR
  596.       yourMAXL : INTEGER;   (* maximum packet length -- up to 94 *)
  597.       yourTIME : INTEGER;   (* time out -- seconds *) 
  598.       (* From Definition Module
  599.       yourNPAD : INTEGER;   (* number of padding characters *)
  600.       yourPADC : CHAR;   (* padding characters *)
  601.       yourEOL  : CHAR;   (* End Of Line -- terminator *)
  602.       *)
  603.       yourQCTL : CHAR;   (* character for quoting controls '#' *)
  604.       yourQBIN : CHAR;   (* character for quoting binary '&' *)
  605.       yourCHKT : CHAR;   (* check type -- 1 = checksum, etc. *)
  606.       sF, rF : File;   (* files being sent/received *)
  607.       sFname, rFname : PathnameType;
  608.       sP, rP : PacketType;   (* packets sent/received *)
  609.       sSeq, rSeq : INTEGER;   (* sequence numbers *)
  610.       PktNbr : INTEGER;   (* actual packet number -- no repeats up to 32,000 *)
  611.                         
  612.  
  613.    PROCEDURE Char (c : INTEGER) : CHAR;
  614.    (* converts a number 0-94 into a printable character *)
  615.       BEGIN
  616.          RETURN (CHR (CARDINAL (ABS (c) + 32)));
  617.       END Char;
  618.       
  619.       
  620.    PROCEDURE UnChar (c : CHAR) : INTEGER;
  621.    (* converts a character into its corresponding number *)
  622.       BEGIN
  623.          RETURN (ABS (INTEGER (ORD (c)) - 32));
  624.       END UnChar;
  625.  
  626.  
  627.    PROCEDURE Aborted() : BOOLEAN;
  628.       
  629.       VAR
  630.          ch : CHAR;
  631.          
  632.       BEGIN
  633.          IF KeyPressed() THEN
  634.             Read (ch);
  635.             IF ch = 033C THEN   (* Escape *)
  636.                RETURN TRUE;
  637.             END;
  638.          END;
  639.          RETURN FALSE;
  640.       END Aborted;
  641.       
  642.       
  643.    PROCEDURE TellError (Seq : INTEGER);
  644.    (* Send error packet *)
  645.       BEGIN
  646.          sP[1] := Char (15);
  647.          sP[2] := Char (Seq);
  648.          sP[3] := 'E';   (* E-type packet *)
  649.          sP[4] := 'R';   (* error message starts *)
  650.          sP[5] := 'e';
  651.          sP[6] := 'm';
  652.          sP[7] := 'o';
  653.          sP[8] := 't';
  654.          sP[9] := 'e';
  655.          sP[10] := ' ';
  656.          sP[11] := 'A';
  657.          sP[12] := 'b';
  658.          sP[13] := 'o';
  659.          sP[14] := 'r';
  660.          sP[15] := 't';
  661.          sP[16] := 0C;
  662.          SendPacket (sP);
  663.       END TellError;
  664.       
  665.       
  666.    PROCEDURE ShowError (p : PacketType);
  667.    (* Output contents of error packet to the screen *)
  668.    
  669.       VAR
  670.          i : INTEGER;
  671.          
  672.       BEGIN
  673.          FOR i := 4 TO UnChar (p[1]) DO
  674.             Write (p[i]);
  675.          END;
  676.          WriteLn;
  677.       END ShowError;
  678.       
  679.       
  680.    PROCEDURE youInit (type : CHAR);   
  681.    (* I initialization YOU for Send and Receive *)      
  682.       BEGIN
  683.          sP[1] := Char (11);   (* Length *)
  684.          sP[2] := Char (0);   (* Sequence *)
  685.          sP[3] := type;
  686.          sP[4] := Char (myMAXL);
  687.          sP[5] := Char (myTIME);
  688.          sP[6] := Char (myNPAD);
  689.          sP[7] := CHAR (ByteXor (myPADC, 100C));
  690.          sP[8] := Char (ORD (myEOL));
  691.          sP[9] := myQCTL;
  692.          sP[10] := myQBIN;
  693.          sP[11] := myCHKT;
  694.          sP[12] := 0C;   (* terminator *)
  695.          SendPacket (sP);
  696.       END youInit;
  697.       
  698.  
  699.    PROCEDURE myInit;
  700.    (* YOU initialize ME for Send and Receive *)
  701.    
  702.       VAR
  703.          len : INTEGER;
  704.          
  705.       BEGIN
  706.          len := UnChar (rP[1]);
  707.          IF len >= 4 THEN
  708.             yourMAXL := UnChar (rP[4]);
  709.          ELSE
  710.             yourMAXL := 94;
  711.          END;
  712.          IF len >= 5 THEN
  713.             yourTIME := UnChar (rP[5]);
  714.          ELSE
  715.             yourTIME := 10;
  716.          END;
  717.          IF len >= 6 THEN
  718.             yourNPAD := UnChar (rP[6]);
  719.          ELSE
  720.             yourNPAD := 0;
  721.          END;
  722.          IF len >= 7 THEN
  723.             yourPADC := CHAR (ByteXor (rP[7], 100C));
  724.          ELSE
  725.             yourPADC := 0C;
  726.          END;
  727.          IF len >= 8 THEN
  728.             yourEOL := CHR (UnChar (rP[8]));
  729.          ELSE
  730.             yourEOL := 0C;
  731.          END;
  732.          IF len >= 9 THEN
  733.             yourQCTL := rP[9];
  734.          ELSE
  735.             yourQCTL := 0C;
  736.          END;
  737.          IF len >= 10 THEN
  738.             yourQBIN := rP[10];
  739.          ELSE
  740.             yourQBIN := 0C;
  741.          END;
  742.          IF len >= 11 THEN
  743.             yourCHKT := rP[11];
  744.             IF yourCHKT # myCHKT THEN
  745.                yourCHKT := '1';
  746.             END;
  747.          ELSE
  748.             yourCHKT := '1';
  749.          END;
  750.       END myInit;
  751.       
  752.             
  753.    PROCEDURE SendInit;
  754.       BEGIN
  755.          youInit ('S');
  756.       END SendInit;
  757.       
  758.       
  759.    PROCEDURE SendFileName;
  760.    
  761.       VAR
  762.          i, j : INTEGER;
  763.          
  764.       BEGIN
  765.          (* send file name *)
  766.          i := 4;   j := 0;
  767.          WHILE sFname[j] # 0C DO
  768.             sP[i] := sFname[j];
  769.             INC (i);   INC (j);
  770.          END;
  771.          sP[1] := Char (j + 3);
  772.          sP[2] := Char (sSeq);
  773.          sP[3] := 'F';   (* filename packet *)
  774.          sP[i] := 0C;
  775.          SendPacket (sP);
  776.       END SendFileName;
  777.       
  778.       
  779.    PROCEDURE SendEOF;
  780.       BEGIN
  781.          sP[1] := Char (3);
  782.          sP[2] := Char (sSeq);
  783.          sP[3] := 'Z';   (* end of file *)
  784.          sP[4] := 0C;
  785.          SendPacket (sP);
  786.       END SendEOF;
  787.       
  788.       
  789.    PROCEDURE SendEOT;
  790.       BEGIN
  791.          sP[1] := Char (3);
  792.          sP[2] := Char (sSeq);
  793.          sP[3] := 'B';   (* break -- end of transmit *)
  794.          sP[4] := 0C;
  795.          SendPacket (sP);
  796.       END SendEOT;
  797.       
  798.       
  799.    PROCEDURE GetAck() : BOOLEAN;
  800.    (* Look for acknowledgement -- retry on timeouts or NAKs *)
  801.    
  802.       VAR
  803.          Type : CHAR;
  804.          Seq : INTEGER;
  805.          retrys : INTEGER;
  806.          AckOK : BOOLEAN;
  807.           
  808.       BEGIN
  809.          WriteString ("Sent Packet #");   
  810.          WriteInt (PktNbr, 5);
  811.          WriteString ("  (ID: ");   WriteHex (sSeq, 4);   
  812.          WriteString ("h)");
  813.          WriteLn;
  814.       
  815.          retrys := MAXtrys;
  816.          LOOP
  817.             IF Aborted() THEN
  818.                TellError (sSeq);
  819.                RETURN FALSE;
  820.             END;
  821.             IF (ReceivePacket (rP)) THEN
  822.                Seq := UnChar (rP[2]);
  823.                Type := rP[3];
  824.                IF (Seq = sSeq) AND (Type = 'Y') THEN
  825.                   AckOK := TRUE;
  826.                ELSIF (Seq = (sSeq + 1) MOD 64) AND (Type = 'N') THEN
  827.                   AckOK := TRUE;   (* NAK for (n + 1) taken as ACK for n *)
  828.                ELSIF Type = 'E' THEN
  829.                   ShowError (rP);
  830.                   AckOK := FALSE;
  831.                   retrys := 0;
  832.                ELSE
  833.                   AckOK := FALSE;
  834.                END;
  835.             ELSE
  836.                AckOK := FALSE;
  837.             END;
  838.             IF AckOK OR (retrys = 0) THEN
  839.                EXIT;
  840.             ELSE
  841.                WriteString ("Resending Packet #");   
  842.                WriteInt (PktNbr, 5);
  843.                WriteString ("  (ID: ");   WriteHex (sSeq, 4);   
  844.                WriteString ("h)");
  845.                WriteLn;
  846.                DEC (retrys);
  847.                FlushUART;
  848.                SendPacket (sP);
  849.             END;
  850.          END;
  851.       
  852.          IF AckOK THEN
  853.             INC (PktNbr);
  854.             sSeq := (sSeq + 1) MOD 64;
  855.             RETURN TRUE;
  856.          ELSE
  857.             RETURN FALSE;
  858.          END;
  859.       END GetAck;
  860.          
  861.  
  862.    PROCEDURE GetInitAck() : BOOLEAN;
  863.    (* configuration for remote station *)
  864.       BEGIN
  865.          IF GetAck() THEN
  866.             myInit;
  867.             RETURN TRUE;
  868.          ELSE 
  869.             RETURN FALSE;
  870.          END;
  871.       END GetInitAck;
  872.       
  873.             
  874.    PROCEDURE Send;
  875.    (* Sends a file after prompting for filename *)
  876.    
  877.       VAR
  878.          ch : CHAR;
  879.          i : INTEGER;
  880.          
  881.       BEGIN
  882.          WriteString ("Send: (filename?): ");
  883.          ReadString (sFname);
  884.          WriteLn;   
  885.          IF Length (sFname) = 0 THEN
  886.             RETURN;
  887.          END;
  888.          IF Open (sF, sFname) # Done THEN
  889.             WriteString ("No such file: ");   WriteString (sFname);
  890.             WriteLn;
  891.             RETURN;
  892.          END;
  893.          WriteString ("(<ESC> to abort file transfer.)");
  894.          WriteLn;   WriteLn;
  895.          FlushUART;
  896.          sSeq := 0;   PktNbr := 0;
  897.          SendInit;   (* my configuration information *)
  898.          IF NOT GetInitAck() THEN     (* get your configuration information *)
  899.             WriteString ("Excessive Errors...");   WriteLn;
  900.             RETURN;
  901.          END;
  902.          
  903.          SendFileName;        
  904.          IF NOT GetAck() THEN
  905.             WriteString ("Excessive Errors...");   WriteLn;
  906.             RETURN;
  907.          END;
  908.          
  909.          (* send file *)
  910.          i := 4;
  911.          LOOP
  912.             IF Aborted() THEN
  913.                TellError (sSeq);
  914.                RETURN;
  915.             END;
  916.             IF Get (sF, ch) = EOF THEN   (* send current packet & terminate *)
  917.                sP[1] := Char (i - 1);
  918.                sP[2] := Char (sSeq);
  919.                sP[3] := 'D';   (* data packet *)
  920.                sP[i] := 0C;   (* indicate end of packet *)
  921.                SendPacket (sP);
  922.                IF NOT GetAck() THEN
  923.                   WriteString ("Excessive Errors...");   WriteLn;
  924.                   RETURN;
  925.                END;
  926.                SendEOF;
  927.                IF NOT GetAck() THEN
  928.                   WriteString ("Excessive Errors...");   WriteLn;
  929.                   RETURN;
  930.                END;
  931.                SendEOT;
  932.                IF NOT GetAck() THEN
  933.                   WriteString ("Excessive Errors...");   WriteLn;
  934.                   RETURN;
  935.                END;
  936.                EXIT;
  937.             END;
  938.                   
  939.             IF i >= (yourMAXL - 4) THEN   (* send current packet *)
  940.                sP[1] := Char (i - 1);
  941.                sP[2] := Char (sSeq);
  942.                sP[3] := 'D';
  943.                sP[i] := 0C;
  944.                SendPacket (sP);
  945.                IF NOT GetAck() THEN
  946.                   WriteString ("Excessive Errors...");   WriteLn;
  947.                   RETURN;
  948.                END;
  949.                i := 4;
  950.             END;
  951.  
  952.             (* add character to current packet -- update count *)
  953.             IF ch > 177C THEN   (* must be quoted (QBIN) and altered *)
  954.                (* toggle bit 7 to turn it off *)
  955.                ch := CHAR (ByteXor (ch, 200C));
  956.                sP[i] := myQBIN;   INC (i);
  957.             END;
  958.             IF (ch < 40C) OR (ch = 177C) THEN   (* quote (QCTL) and alter *)
  959.                (* toggle bit 6 to turn it on *)
  960.                ch := CHAR (ByteXor (ch, 100C));
  961.                sP[i] := myQCTL;   INC (i);
  962.             END;
  963.             IF (ch = myQCTL) OR (ch = myQBIN) THEN   (* must send it quoted *)
  964.                sP[i] := myQCTL;   INC (i);
  965.             END;
  966.             sP[i] := ch;   INC (i);
  967.          END;   (* loop *)
  968.          
  969.          IF CloseFile (sF, Input) # Done THEN
  970.             WriteString ("Problem closing source file...");   WriteLn;
  971.          END;
  972.       END Send;
  973.       
  974.  
  975.    PROCEDURE ReceiveInit() : BOOLEAN;
  976.    (* receive my initialization information from you *)
  977.    
  978.       VAR
  979.          RecOK : BOOLEAN;
  980.          errors : INTEGER;
  981.           
  982.       BEGIN
  983.          errors := 0;
  984.          LOOP
  985.             IF Aborted() THEN
  986.                TellError (rSeq);
  987.                RETURN FALSE;
  988.             END;
  989.             RecOK := (ReceivePacket (rP)) AND (rP[3] = 'S');
  990.             IF RecOK OR (errors = MAXtrys) THEN
  991.                EXIT;
  992.             ELSE
  993.                INC (errors);
  994.                SendNak;
  995.             END;
  996.          END;
  997.          
  998.          IF RecOK THEN
  999.             myInit;
  1000.             RETURN TRUE;
  1001.          ELSE
  1002.             RETURN FALSE;
  1003.          END;   
  1004.       END ReceiveInit;
  1005.       
  1006.       
  1007.    PROCEDURE SendInitAck;
  1008.    (* acknowledge your initialization of ME and send mine for YOU *)
  1009.       BEGIN
  1010.          WriteString ("Received Packet #");   
  1011.          WriteInt (PktNbr, 5);
  1012.          WriteString ("  (ID: ");   WriteHex (rSeq, 4);   
  1013.          WriteString ("h)");
  1014.          WriteLn;
  1015.          INC (PktNbr);
  1016.          rSeq := (rSeq + 1) MOD 64;
  1017.          youInit ('Y');
  1018.       END SendInitAck;
  1019.       
  1020.       
  1021.    PROCEDURE ValidFileChar (VAR ch : CHAR) : BOOLEAN;
  1022.    (* checks if character is one of 'A'..'Z', '0'..'9', makes upper case *)
  1023.       BEGIN
  1024.          ch := CAP (ch);
  1025.          RETURN ((ch >= 'A') AND (ch <= 'Z')) OR ((ch >= '0') AND (ch <= '9'));
  1026.       END ValidFileChar;
  1027.  
  1028.  
  1029.    TYPE
  1030.       HeaderType = (name, eot, fail);
  1031.       
  1032.    PROCEDURE ReceiveHeader() : HeaderType;
  1033.    (* receive the filename -- alter for local conditions, if necessary *)
  1034.    
  1035.       VAR
  1036.          i, j, k : INTEGER;
  1037.          RecOK : BOOLEAN;
  1038.          errors : INTEGER;
  1039.          
  1040.       BEGIN
  1041.          errors := 0;
  1042.          LOOP
  1043.             RecOK := ReceivePacket (rP) AND ((rP[3] = 'F') OR (rP[3] = 'B'));
  1044.             IF errors = MAXtrys THEN
  1045.                RETURN fail;
  1046.             ELSIF RecOK AND (rP[3] = 'F') THEN
  1047.                i := 4;   (* data starts here *)
  1048.                j := 0;   (* beginning of filename string *)
  1049.                WHILE (ValidFileChar (rP[i])) AND (j < 8) DO
  1050.                   rFname[j] := rP[i];
  1051.                   INC (i);   INC (j);
  1052.                END;
  1053.                REPEAT
  1054.                   INC (i);
  1055.                UNTIL (ValidFileChar (rP[i])) OR (rP[i] = 0C);
  1056.                rFname[j] := '.';   INC (j);
  1057.                k := 0;
  1058.                WHILE (ValidFileChar (rP[i])) AND (k < 3) DO
  1059.                   rFname[j + k] := rP[i];
  1060.                   INC (i);   INC (k);
  1061.                END;
  1062.                rFname[j + k] := 0C;  
  1063.                WriteString ("Filename = ");   WriteString (rFname);   WriteLn;
  1064.                RETURN name;
  1065.             ELSIF RecOK AND (rP[3] = 'B') THEN
  1066.                RETURN eot;
  1067.             ELSE
  1068.                INC (errors);
  1069.                SendNak;
  1070.             END;
  1071.          END;
  1072.       END ReceiveHeader;
  1073.       
  1074.       
  1075.    PROCEDURE SendNak;
  1076.       BEGIN
  1077.          WriteString ("Requesting Repeat of Packet #");   
  1078.          WriteInt (PktNbr, 5);
  1079.          WriteString ("  (ID: ");   WriteHex (rSeq, 4);   
  1080.          WriteString ("h)");
  1081.          WriteLn;
  1082.          FlushUART;
  1083.          sP[1] := Char (3);   (* LEN *)
  1084.          sP[2] := Char (rSeq); 
  1085.          sP[3] := 'N';   (* negative acknowledgement *)
  1086.          sP[4] := 0C;
  1087.          SendPacket (sP);
  1088.       END SendNak;
  1089.       
  1090.       
  1091.    PROCEDURE SendAck (Seq : INTEGER);
  1092.       BEGIN
  1093.          IF Seq # rSeq THEN
  1094.             WriteString ("Duplicate Packet      ");
  1095.          ELSE
  1096.             WriteString ("Received Packet #");   WriteInt (PktNbr, 5);
  1097.             rSeq := (rSeq + 1) MOD 64;
  1098.             INC (PktNbr);
  1099.          END;
  1100.          WriteString ("  (ID: ");   WriteHex (Seq, 4);   
  1101.          WriteString ("h)");
  1102.          WriteLn;
  1103.          sP[1] := Char (3);
  1104.          sP[2] := Char (Seq);
  1105.          sP[3] := 'Y';   (* acknowledgement *)
  1106.          sP[4] := 0C;
  1107.          SendPacket (sP);
  1108.       END SendAck;
  1109.       
  1110.       
  1111.    PROCEDURE Receive;
  1112.    (* Receives a file  (or files) *)
  1113.    
  1114.       VAR
  1115.          ch, Type : CHAR;
  1116.          Seq : INTEGER;
  1117.          i : INTEGER;
  1118.          EOF, EOT, QBIN : BOOLEAN;
  1119.          errors : INTEGER;
  1120.                   
  1121.       BEGIN
  1122.          WriteString ("Ready to receive file(s)...");   WriteLn;
  1123.          WriteString ("(<ESC> to abort file transfer.)");
  1124.          WriteLn;   WriteLn;
  1125.          FlushUART;
  1126.          rSeq := 0;   PktNbr := 0;  
  1127.          IF NOT ReceiveInit() THEN   (* your configuration information *)
  1128.             WriteString ("Excessive Errors...");   WriteLn;
  1129.             RETURN;
  1130.          END;
  1131.          SendInitAck;       (* send my configuration information *)
  1132.          EOT := FALSE;
  1133.          WHILE NOT EOT DO
  1134.             IF Aborted() THEN
  1135.                TellError (rSeq);
  1136.                RETURN;
  1137.             END;
  1138.             CASE ReceiveHeader() OF
  1139.                eot  : EOT := TRUE;   EOF := TRUE;
  1140.             |  name : IF Create (rF, rFname) # Done THEN
  1141.                          WriteString ("Unable to open file: ");
  1142.                          WriteString (rFname);   WriteLn;
  1143.                          RETURN;
  1144.                       ELSE
  1145.                          PktNbr := 1;
  1146.                          EOF := FALSE;
  1147.                       END;
  1148.             |  fail : WriteString ("Excessive Errors...");   WriteLn;
  1149.                       RETURN;
  1150.             END;
  1151.             SendAck (rSeq);   (* acknowledge for name or eot *)
  1152.             WHILE NOT EOF DO
  1153.                IF Aborted() THEN
  1154.                   TellError (rSeq);
  1155.                   RETURN;
  1156.                END;
  1157.                IF ReceivePacket (rP) THEN
  1158.                   Seq := UnChar (rP[2]);
  1159.                   Type := rP[3];
  1160.                   IF Type = 'Z' THEN
  1161.                      EOF := TRUE;
  1162.                      IF CloseFile (rF, Output) # Done THEN
  1163.                         WriteString ("Error closing file: ");   
  1164.                         WriteString (rFname);   WriteLn;
  1165.                         RETURN;
  1166.                      END;
  1167.                      SendAck (rSeq);
  1168.                   ELSIF Type = 'E' THEN
  1169.                      ShowError (rP);
  1170.                      RETURN;
  1171.                   ELSIF (Type = 'D') AND ((Seq + 1) MOD 64 = rSeq) THEN
  1172.                   (* discard duplicate packet, and Ack anyway *)
  1173.                      SendAck (Seq); 
  1174.                   ELSIF (Type = 'D') AND (Seq = rSeq) THEN
  1175.                      (* put packet into file buffer *)
  1176.                      i := 4;   (* first data in packet *)
  1177.                      WHILE rP[i] # 0C DO
  1178.                         ch := rP[i];   INC (i);
  1179.                         IF ch = yourQBIN THEN
  1180.                            ch := rP[i];   INC (i);
  1181.                            QBIN := TRUE;
  1182.                         ELSE
  1183.                            QBIN := FALSE;
  1184.                         END;
  1185.                         IF ch = yourQCTL THEN                  
  1186.                            ch := rP[i];   INC (i);
  1187.                            IF (ch # yourQCTL) AND (ch # yourQBIN) THEN
  1188.                               ch := CHAR (ByteXor (ch, 100C));
  1189.                            END;
  1190.                         END;
  1191.                         IF QBIN THEN
  1192.                            ch := CHAR (ByteXor (ch, 200C));
  1193.                         END;
  1194.                         Put (ch);
  1195.                      END;
  1196.                   
  1197.                      (* write file buffer to disk *)
  1198.                      IF DoWrite (rF) # Done THEN
  1199.                         WriteString ("Error writing to file: ");   
  1200.                         WriteString (rFname);   WriteLn;
  1201.                         RETURN;
  1202.                      END;
  1203.                      errors := 0;
  1204.                      SendAck (rSeq);
  1205.                   ELSE
  1206.                      INC (errors);
  1207.                      IF errors = MAXtrys THEN
  1208.                         WriteString ("Excessive errors...");   WriteLn;
  1209.                         RETURN;
  1210.                      ELSE
  1211.                         SendNak;
  1212.                      END;
  1213.                   END;
  1214.                ELSE
  1215.                   INC (errors);
  1216.                   IF errors = MAXtrys THEN
  1217.                      WriteString ("Excessive errors...");   WriteLn;
  1218.                      RETURN;
  1219.                   ELSE
  1220.                      SendNak;
  1221.                   END;
  1222.                END;
  1223.             END;
  1224.          END;
  1225.       END Receive;
  1226.       
  1227.       
  1228. BEGIN   (* module initialization *)
  1229.    yourEOL := ASCII.cr;
  1230.    yourNPAD := 0;
  1231.    yourPADC := 0C;
  1232. END PAD.
  1233.  
  1234.  
  1235.  
  1236. [LISTING EIGHT]
  1237.  
  1238.  
  1239. IMPLEMENTATION MODULE Files;   (* File I/O for Kermit *)
  1240.  
  1241.    FROM FileSystem IMPORT
  1242.       File, Response, Delete, Lookup, Close, ReadNBytes, WriteNBytes;
  1243.  
  1244.    FROM InOut IMPORT
  1245.       Read, WriteString, WriteLn, Write;
  1246.         
  1247.    FROM SYSTEM IMPORT
  1248.       ADR, SIZE;
  1249.  
  1250.       
  1251.    TYPE
  1252.       buffer = ARRAY [1..512] OF CHAR;
  1253.       
  1254.    VAR
  1255.       inBuf, outBuf : buffer;
  1256.       inP, outP : CARDINAL;   (* buffer pointers *)
  1257.       read, written : CARDINAL;   (* number of bytes read or written *)
  1258.                                   (* by ReadNBytes or WriteNBytes    *)
  1259.        
  1260.       
  1261.    PROCEDURE Open (VAR f : File; name : ARRAY OF CHAR) : Status;
  1262.    (* opens an existing file for reading, returns status *)
  1263.       BEGIN
  1264.          Lookup (f, name, FALSE);
  1265.          IF f.res = done THEN
  1266.             inP := 0;   read := 0;
  1267.             RETURN Done;
  1268.          ELSE
  1269.             RETURN Error;
  1270.          END;
  1271.       END Open;
  1272.       
  1273.       
  1274.    PROCEDURE Create (VAR f : File; name : ARRAY OF CHAR) : Status;
  1275.    (* creates a new file for writing, returns status *)
  1276.    
  1277.       VAR
  1278.          ch : CHAR;
  1279.          
  1280.       BEGIN
  1281.          Lookup (f, name, FALSE);   (* check to see if file exists *)
  1282.          IF f.res = done THEN
  1283.             Close (f);
  1284.             WriteString ("File exists!  Overwrite? (Y/N): ");
  1285.             Read (ch);   Write (ch);   WriteLn;
  1286.             IF CAP (ch) = 'Y' THEN
  1287.                Delete (name, f);
  1288.                Close (f);
  1289.             ELSE
  1290.                RETURN Error;
  1291.             END;
  1292.          END;
  1293.          Lookup (f, name, TRUE);
  1294.          IF f.res = done THEN
  1295.             outP := 0;
  1296.             RETURN Done;
  1297.          ELSE
  1298.             RETURN Error;
  1299.          END;
  1300.       END Create;
  1301.       
  1302.       
  1303.    PROCEDURE CloseFile (VAR f : File; Which : FileType) : Status;
  1304.    (* closes a file after reading or writing *)
  1305.       BEGIN
  1306.          written := outP;
  1307.          IF (Which = Output) AND (outP > 0) THEN
  1308.             WriteNBytes (f, ADR (outBuf), outP, written);
  1309.          END;
  1310.          Close (f);
  1311.          IF (written = outP) AND (f.res = done) THEN
  1312.             RETURN Done;
  1313.          ELSE
  1314.             RETURN Error;
  1315.          END;
  1316.       END CloseFile;
  1317.       
  1318.       
  1319.    PROCEDURE Get (VAR f : File; VAR ch : CHAR) : Status;
  1320.    (* Reads one character from the file, returns status *)
  1321.       BEGIN
  1322.          IF inP = read THEN
  1323.             ReadNBytes (f, ADR (inBuf), SIZE (inBuf), read);
  1324.             inP := 0;
  1325.          END;
  1326.          IF read = 0 THEN
  1327.             RETURN EOF;
  1328.          ELSE
  1329.             INC (inP);
  1330.             ch := inBuf[inP];
  1331.             RETURN Done;
  1332.          END;
  1333.       END Get;
  1334.       
  1335.       
  1336.    PROCEDURE Put (ch : CHAR);
  1337.    (* Writes one character to the file buffer *)
  1338.       BEGIN
  1339.          INC (outP);
  1340.          outBuf[outP] := ch;
  1341.       END Put;
  1342.       
  1343.       
  1344.    PROCEDURE DoWrite (VAR f : File) : Status;
  1345.    (* Writes buffer to disk only if nearly full *)
  1346.       BEGIN
  1347.          IF outP < 400 THEN   (* still room in buffer *)
  1348.             RETURN Done;
  1349.          ELSE
  1350.             WriteNBytes (f, ADR (outBuf), outP, written);
  1351.             IF (written = outP) AND (f.res = done) THEN
  1352.                outP := 0;
  1353.                RETURN Done;
  1354.             ELSE
  1355.                RETURN Error;
  1356.             END;
  1357.          END;
  1358.       END DoWrite;  
  1359.  
  1360. END Files.
  1361.  
  1362.  
  1363.  
  1364. [LISTING NINE]
  1365.  
  1366.  
  1367. IMPLEMENTATION MODULE DataLink;   (* Sends and Receives Packets for PCKermit *)
  1368.  
  1369.    FROM InOut IMPORT
  1370.       WriteString, WriteLn;
  1371.       
  1372.    FROM Delay IMPORT
  1373.       Delay;   (* delay is in milliseconds *)
  1374.  
  1375.    FROM BitByteOps IMPORT
  1376.       ByteAnd;
  1377.             
  1378.    IMPORT RS232Int;   (* for RS232Int.BusyRead, RS232Int.Write *)
  1379.  
  1380.    FROM PAD IMPORT
  1381.       PacketType, yourNPAD, yourPADC, yourEOL; 
  1382.  
  1383.    IMPORT ASCII;
  1384.  
  1385.  
  1386.    CONST
  1387.       MAXtime = 10000;
  1388.       MAXsohtrys = 100;
  1389.                
  1390.    VAR
  1391.       ch : CHAR;
  1392.       GotChar : BOOLEAN;
  1393.       
  1394.             
  1395.    PROCEDURE Char (c : INTEGER) : CHAR;
  1396.    (* converts a number 0-95 into a printable character *)
  1397.       BEGIN
  1398.          RETURN (CHR (CARDINAL (ABS (c) + 32)));
  1399.       END Char;
  1400.       
  1401.       
  1402.    PROCEDURE UnChar (c : CHAR) : INTEGER;
  1403.    (* converts a character into its corresponding number *)
  1404.       BEGIN
  1405.          RETURN (ABS (INTEGER (ORD (c)) - 32));
  1406.       END UnChar;
  1407.  
  1408.  
  1409.    PROCEDURE FlushUART;
  1410.    (* ensure no characters left in UART holding registers *)
  1411.       BEGIN
  1412.          Delay (500);
  1413.          REPEAT
  1414.             RS232Int.BusyRead (ch, GotChar);
  1415.          UNTIL NOT GotChar;
  1416.       END FlushUART;
  1417.         
  1418.  
  1419.    PROCEDURE SendPacket (s : PacketType);
  1420.    (* Adds SOH and CheckSum to packet *)
  1421.    
  1422.       VAR
  1423.          i : INTEGER;
  1424.          checksum : INTEGER;
  1425.          
  1426.       BEGIN
  1427.          Delay (10);   (* give host a chance to catch its breath *)
  1428.          FOR i := 1 TO yourNPAD DO
  1429.             RS232Int.Write (yourPADC);
  1430.          END;
  1431.          RS232Int.Write (ASCII.soh);
  1432.          i := 1;
  1433.          checksum := 0;
  1434.          WHILE s[i] # 0C DO
  1435.             INC (checksum, ORD (s[i]));
  1436.             RS232Int.Write (s[i]);
  1437.             INC (i);
  1438.          END;
  1439.          checksum := checksum + (INTEGER (BITSET (checksum) * {7, 6}) DIV 64);
  1440.          checksum := INTEGER (BITSET (checksum) * {5, 4, 3, 2, 1, 0});
  1441.          RS232Int.Write (Char (checksum));
  1442.          IF yourEOL # 0C THEN
  1443.             RS232Int.Write (yourEOL);
  1444.          END;
  1445.       END SendPacket;
  1446.       
  1447.       
  1448.    PROCEDURE ReceivePacket (VAR r : PacketType) : BOOLEAN;
  1449.    (* strips SOH and checksum -- return FALSE if timed out or bad checksum *)
  1450.    
  1451.       VAR
  1452.          sohtrys, time : INTEGER;
  1453.          i, len : INTEGER;
  1454.          ch : CHAR;
  1455.          checksum : INTEGER;
  1456.          mycheck, yourcheck : CHAR;
  1457.          
  1458.       BEGIN
  1459.          sohtrys := MAXsohtrys;
  1460.          REPEAT
  1461.             time := MAXtime;
  1462.             REPEAT
  1463.                DEC (time);
  1464.                RS232Int.BusyRead (ch, GotChar);
  1465.             UNTIL GotChar OR (time = 0);
  1466.             ch := CHAR (ByteAnd (ch, 177C));   (* mask off MSB *)
  1467.             (* skip over up to MAXsohtrys padding characters, *)
  1468.             (* but allow only MAXsohtrys/10 timeouts          *)
  1469.             IF GotChar THEN
  1470.                DEC (sohtrys);
  1471.             ELSE
  1472.                DEC (sohtrys, 10);
  1473.             END;
  1474.          UNTIL (ch = ASCII.soh) OR (sohtrys <= 0);
  1475.          
  1476.          IF ch = ASCII.soh THEN
  1477.             (* receive rest of packet *)
  1478.             time := MAXtime;
  1479.             REPEAT
  1480.                DEC (time);
  1481.                RS232Int.BusyRead (ch, GotChar);
  1482.             UNTIL GotChar OR (time = 0);
  1483.             ch := CHAR (ByteAnd (ch, 177C));
  1484.             len := UnChar (ch);
  1485.             r[1] := ch;
  1486.             checksum := ORD (ch);
  1487.             i := 2;   (* on to second character in packet -- after LEN *)
  1488.             REPEAT
  1489.                time := MAXtime;
  1490.                REPEAT
  1491.                   DEC (time);
  1492.                   RS232Int.BusyRead (ch, GotChar);
  1493.                UNTIL GotChar OR (time = 0);
  1494.                ch := CHAR (ByteAnd (ch, 177C));
  1495.                r[i] := ch;   INC (i);
  1496.                INC (checksum, (ORD (ch)));   
  1497.             UNTIL (i > len);
  1498.             time := MAXtime;
  1499.             REPEAT 
  1500.                DEC (time);
  1501.                RS232Int.BusyRead (ch, GotChar);
  1502.             UNTIL GotChar OR (time = 0);   (* get checksum character *)
  1503.             ch := CHAR (ByteAnd (ch, 177C));
  1504.             yourcheck := ch;
  1505.             r[i] := 0C;
  1506.             checksum := checksum + 
  1507.                             (INTEGER (BITSET (checksum) * {7, 6}) DIV 64);
  1508.             checksum := INTEGER (BITSET (checksum) *  {5, 4, 3, 2, 1, 0});
  1509.             mycheck := Char (checksum);
  1510.             IF mycheck = yourcheck THEN   (* checksum OK *)
  1511.                RETURN TRUE;
  1512.             ELSE   (* ERROR!!! *)
  1513.                WriteString ("Bad Checksum");   WriteLn;
  1514.                RETURN FALSE;
  1515.             END;
  1516.          ELSE
  1517.             WriteString ("No SOH");   WriteLn;
  1518.             RETURN FALSE;
  1519.          END;
  1520.       END ReceivePacket;
  1521.  
  1522. END DataLink.
  1523.  
  1524.  
  1525.